(*--------------------------------------------------------
    Holt                  http://coderesearchlabs.com/holt
    by Javier Santo Domingo (j-a-s-d@coderesearchlabs.com)
  --------------------------------------------------------
    instructions
  --------------------------------------------------------*)

unit holt_instructions;

interface

{$I holt_defines.inc}

uses
  holt_architecture,
  holt_types;

function NewInstructionsSelector: IhInstructionsSelector;

implementation

uses
  holt_consts;

function _HELP(var ARegisters: ThRegisters): gString;
begin
  result := MSG_HELP;
end;

function _COMMENT(var ARegisters: ThRegisters): gString;
begin
  result := '';
end;

function _GLOBAL(var ARegisters: ThRegisters): gString;

  function doGlobal(AGlobal: gString): gString; //inline;
  var name, value: gString; x, l: gNumber; hasValue: boolean;

    procedure crackGlobal; inline;
    begin
      x := pos('=', AGlobal);
      hasValue := x > 0;
      if hasValue then begin
        l := length(AGlobal);
        name := copy(AGlobal, 1, x - 1);
        value := copy(AGlobal, x + 1, l - x);
        hasValue := length(value) > 0;
      end else
        name := AGlobal;
    end;

  begin
    result := '';
    crackGlobal;
    if name = GLOBAL_DEBUG then
      if hasValue then begin
        Val(value, x);
        ARegisters.Flags.Debug := x <> 0;
      end else
        result := ARegisters.ReportBuilder.AsError(MSG_VALUE_REQUIRED);
  end;

begin
  with ARegisters do
    if not Flags.Parameters then
      result := ReportBuilder.AsError(MSG_PARAMETER_REQUIRED)
    else
      result := doGlobal(Command.Parameters);
end;

function _NAVIGATE(var ARegisters: ThRegisters): gString;
begin
  with ARegisters do
    if not Flags.Parameters then
      result := ReportBuilder.AsError(MSG_PARAMETER_REQUIRED)
    else if not Tree.GotoChild(Command.Parameters) then
      result := ReportBuilder.AsError(MSG_UNKNOWN_OPCODE)
    else
      result := ReportBuilder.AsKindsForLevel(EmissionController.GetCurrentEmitter, Tree.GetLevel);
end;

function _INFO(var ARegisters: ThRegisters): gString;
begin
  with ARegisters do
    result := ReportBuilder.AsMultiline(MSG_INFO, Tree.GetInfo);
end;

function _PARENT(var ARegisters: ThRegisters): gString;
begin
  with ARegisters do
    if not Tree.GotoParent then
      result := ReportBuilder.AsError
    else
      result := ReportBuilder.AsKindsForLevel(EmissionController.GetCurrentEmitter, Tree.GetLevel);
end;

function _DROP(var ARegisters: ThRegisters): gString;
begin
  with ARegisters do
    if not Tree.Drop then
      result := ReportBuilder.AsError
    else
      result := '';
end;

function _TREE(var ARegisters: ThRegisters): gString;
begin
  with ARegisters do
    result := ReportBuilder.AsMultiline(MSG_TREE, Tree.AsText);
end;

function _FLIP(var ARegisters: ThRegisters): gString;
begin
  with ARegisters do
    if not Tree.Flip then
      result := ReportBuilder.AsError
    else
      result := '';
end;

function _TRUNCATE(var ARegisters: ThRegisters): gString;
begin
  with ARegisters do
    if not Tree.Truncate then
      result := ReportBuilder.AsError
    else
      result := '';
end;

function _REBASE(var ARegisters: ThRegisters): gString;
begin
  with ARegisters do
    if not Tree.Rebase then
      result := ReportBuilder.AsError
    else
      result := '';
end;

function _SEARCH(var ARegisters: ThRegisters): gString;
begin
  with ARegisters do
    if not Flags.Parameters then
      result := ReportBuilder.AsError(MSG_PARAMETER_REQUIRED)
    else
      result := ReportBuilder.AsMultiline(MSG_RESULTS, Tree.Search(Command.Parameters));
end;

function _ADD(var ARegisters: ThRegisters): gString;
begin
  with ARegisters do
    if not Flags.Parameters then
      result := ReportBuilder.AsError(MSG_PARAMETER_REQUIRED)
    else if not Tree.AddChild(Command.Parameters) then
      result := ReportBuilder.AsError
    else
      result := ReportBuilder.AsKindsForLevel(EmissionController.GetCurrentEmitter, Tree.GetLevel);
end;

function _DELETE(var ARegisters: ThRegisters): gString;
begin
  with ARegisters do
    if not Flags.Parameters then
      result := ReportBuilder.AsError(MSG_PARAMETER_REQUIRED)
    else if not Tree.DeleteChild(Command.Parameters) then
      result := ReportBuilder.AsError
    else
      result := '';
end;

function _RENAME(var ARegisters: ThRegisters): gString;
begin
  with ARegisters do
    if not Flags.Parameters then
      result := ReportBuilder.AsError(MSG_PARAMETER_REQUIRED)
    else if not Tree.SetName(Command.Parameters) then
      result := ReportBuilder.AsError
    else
      result := '';
end;

function _VALUE(var ARegisters: ThRegisters): gString;
begin
  with ARegisters do
    if not Flags.Parameters then
      result := ReportBuilder.AsError(MSG_PARAMETER_REQUIRED)
    else if not Tree.SetValue(Command.Parameters) then
      result := ReportBuilder.AsError
    else
      result := '';
end;

function _KIND(var ARegisters: ThRegisters): gString;
begin
  with ARegisters do
    if not Flags.Parameters then
      result := ReportBuilder.AsError(MSG_PARAMETER_REQUIRED)
    else if not Tree.SetKind(Command.Parameters) then
      result := ReportBuilder.AsError
    else
      result := '';
end;

function _UP(var ARegisters: ThRegisters): gString;
begin
  with ARegisters do
    if not Flags.Parameters then
      result := ReportBuilder.AsError(MSG_PARAMETER_REQUIRED)
    else if not Tree.UpChild(Command.Parameters) then
      result := ReportBuilder.AsError
    else
      result := '';
end;

function _DOWN(var ARegisters: ThRegisters): gString;
begin
  with ARegisters do
    if not Flags.Parameters then
      result := ReportBuilder.AsError(MSG_PARAMETER_REQUIRED)
    else if not Tree.DownChild(Command.Parameters) then
      result := ReportBuilder.AsError
    else
      result := '';
end;

function _EXECUTE(var ARegisters: ThRegisters): gString;

  function executeCommandsFromFile: gBoolean; inline;
  var lFile: gTextFile; command: gString; flag: gBoolean;
  begin
    assignfile(lFile, ARegisters.Command.Parameters);
    {$I-}reset(lFile);{$I+}
    result := ioresult = 0;
    if result then
    try
      flag := true;
      while not eof(lFile) and flag do begin
        readln(lFile, command);
        flag := ARegisters.ExecutionBridge.ExecuteCommand(pchar(command));
      end;
    finally
      close(lFile);
    end;
  end;

begin
  with ARegisters do
    if not Flags.Parameters then
      result := ReportBuilder.AsError(MSG_PARAMETER_REQUIRED)
    else if not executeCommandsFromFile then
      result := ReportBuilder.AsError
    else
      result := '';
end;

function _PERSIST(var ARegisters: ThRegisters): gString;

  function persistTreeToFileAsCommands: gBoolean; inline;
  var lFile: gTextFile;
  begin
    assignfile(lFile, ARegisters.Command.Parameters);
    {$I-}rewrite(lFile);{$I+}
    result := ioresult = 0;
    if result then
    try
      writeln(lFile, ARegisters.Tree.AsCommands);
      close(lFile);
    except
      result := false;
    end;
  end;

begin
  with ARegisters do
    if not Flags.Parameters then
      result := ReportBuilder.AsError(MSG_PARAMETER_REQUIRED)
    else if not persistTreeToFileAsCommands then
      result := ReportBuilder.AsError
    else
      result := '';
end;

function _EMIT(var ARegisters: ThRegisters): gString;
begin
  with ARegisters do
    if not Flags.Parameters then
      result := ReportBuilder.AsError(MSG_PARAMETER_REQUIRED)
    else if not assigned(EmissionController.GetCurrentEmitter) then
      result := ReportBuilder.AsError(MSG_SELECT_EMITTER)
    else if not EmissionController.GetCurrentEmitter.Emit(Tree, Command.Parameters) then
      result := ReportBuilder.AsError(EmissionController.GetCurrentEmitter.GetLastResult)
    else
      result := '';
end;

function _EMITTERS(var ARegisters: ThRegisters): gString;

  function executeUnparametrized: gString; inline;
  begin
    with ARegisters do
      result := ReportBuilder.AsMultiline(MSG_EMITTERS, EmissionController.GetEmittersList);
  end;

  function executeParametrized: gString; inline;
  begin
    with ARegisters do
      if not Flags.Parameters then
        result := ReportBuilder.AsError(MSG_PARAMETER_REQUIRED)
      else if EmissionController.LoadEmitter(Command.Parameters) then
        result := ReportBuilder.AsMultiline(MSG_EMITTERS, EmissionController.GetEmittersList)
      else
        result := ReportBuilder.AsError;
  end;

begin
  if ARegisters.Flags.Parameters then
    result := executeParametrized
  else
    result := executeUnparametrized;
end;

function _RELOAD(var ARegisters: ThRegisters): gString;
begin
  with ARegisters do
    if not Flags.Parameters then
      result := ReportBuilder.AsError(MSG_PARAMETER_REQUIRED)
    else if EmissionController.ReloadEmitter(Command.Parameters) then
      result := ReportBuilder.AsMultiline(MSG_EMITTERS, EmissionController.GetEmittersList)
    else
      result := ReportBuilder.AsError;
end;

function _EMITTER(var ARegisters: ThRegisters): gString;

  function executeUnparametrized: gString; inline;
  begin
    with ARegisters do
      if assigned(EmissionController.GetCurrentEmitter) then
        result := ReportBuilder.AsLine(MSG_EMITTER, EmissionController.GetCurrentEmitter.GetName + LineEnding)
      else
        result := ReportBuilder.AsError(MSG_SELECT_EMITTER);
  end;

  function executeParametrized: gString; inline;
  begin
    with ARegisters do
      if not Flags.Parameters then
        result := ReportBuilder.AsError(MSG_PARAMETER_REQUIRED)
      else if EmissionController.SetCurrentEmitter(Command.Parameters) then
        result := ReportBuilder.AsLine(MSG_EMITTER, EmissionController.GetCurrentEmitter.GetName + LineEnding)
      else
        result := ReportBuilder.AsError;
  end;

begin
  if ARegisters.Flags.Parameters then
    result := executeParametrized
  else
    result := executeUnparametrized;
end;

function _PATH(var ARegisters: ThRegisters): gString;

  function executeParametrized: gString; inline;
  begin
    with ARegisters do
      if not Tree.GotoPath(ARegisters.Command.Parameters) then
        result := ReportBuilder.AsError
      else
        result := ReportBuilder.AsKindsForLevel(EmissionController.GetCurrentEmitter, Tree.GetLevel);
  end;

  function executeUnparametrized: gString; inline;
  begin
    with ARegisters do
      if not Tree.GotoRoot then
        result := ReportBuilder.AsError
      else
        result := ReportBuilder.AsKindsForLevel(EmissionController.GetCurrentEmitter, Tree.GetLevel);
  end;

begin
  if ARegisters.Flags.Parameters then
    result := executeParametrized
  else
    result := executeUnparametrized;
end;

function _NONE(var ARegisters: ThRegisters): gString;
begin
  result := ARegisters.ReportBuilder.AsError(MSG_UNKNOWN_OPCODE);
end;

{ ThInstructionsSelector }

type
  ThInstructions = array of ThInstruction;

  ThInstructionsSelector = class(TInterfacedObject, IhInstructionsSelector)
  strict private
    FInstructions: ThInstructions;
    function IncludeInstruction(AOpcode: gChar; AInstructionRun: ThInstructionRun): gBoolean;
  strict protected
    function FetchByOpcode(AOpcode: gChar): ThInstruction;
  public
    procedure AfterConstruction; override;
  end;

function ThInstructionsSelector.FetchByOpcode(AOpcode: gChar): ThInstruction;
var Instruction: ThInstruction;
begin
  result.Opcode := OPCODE_NONE;
  result.Run := @_NONE;
  if Length(FInstructions) > 0 then
    for Instruction in FInstructions do
      if (Instruction.Opcode = AOpcode) then begin
        result := Instruction;
        break;
      end;
end;

function ThInstructionsSelector.IncludeInstruction(AOpcode: gChar; AInstructionRun: ThInstructionRun): gBoolean;
var index: gNumber; instruction: ThInstruction;
begin
  result := FetchByOpcode(AOpcode).Opcode = OPCODE_NONE;
  if result then
  try
    instruction.Opcode := AOpcode;
    instruction.Run := AInstructionRun;
    index := Length(FInstructions);
    SetLength(FInstructions, index+1);
    FInstructions[index] := instruction;
  except
    result := false;
  end;
end;

procedure ThInstructionsSelector.AfterConstruction;
begin
  inherited;
  // tree related opcodes
  IncludeInstruction(OPCODE_NAVIGATE, @_NAVIGATE);
  IncludeInstruction(OPCODE_PARENT, @_PARENT);
  IncludeInstruction(OPCODE_PATH, @_PATH);
  IncludeInstruction(OPCODE_TREE, @_TREE);
  IncludeInstruction(OPCODE_SEARCH, @_SEARCH);
  IncludeInstruction(OPCODE_DROP, @_DROP);
  IncludeInstruction(OPCODE_PERSIST, @_PERSIST);
  IncludeInstruction(OPCODE_EXECUTE, @_EXECUTE);
  // node related opcodes
  IncludeInstruction(OPCODE_ADD, @_ADD);
  IncludeInstruction(OPCODE_DELETE, @_DELETE);
  IncludeInstruction(OPCODE_RENAME, @_RENAME);
  IncludeInstruction(OPCODE_VALUE, @_VALUE);
  IncludeInstruction(OPCODE_KIND, @_KIND);
  IncludeInstruction(OPCODE_INFO, @_INFO);
  IncludeInstruction(OPCODE_UP, @_UP);
  IncludeInstruction(OPCODE_DOWN, @_DOWN);
  IncludeInstruction(OPCODE_FLIP, @_FLIP);
  IncludeInstruction(OPCODE_REBASE, @_REBASE);
  IncludeInstruction(OPCODE_TRUNCATE, @_TRUNCATE);
  // emitter related opcodes
  IncludeInstruction(OPCODE_EMITTERS, @_EMITTERS);
  IncludeInstruction(OPCODE_RELOAD, @_RELOAD);
  IncludeInstruction(OPCODE_EMITTER, @_EMITTER);
  IncludeInstruction(OPCODE_EMIT, @_EMIT);
  // general opcodes
  IncludeInstruction(OPCODE_GLOBAL, @_GLOBAL);
  IncludeInstruction(OPCODE_COMMENT, @_COMMENT);
  IncludeInstruction(OPCODE_HELP, @_HELP);
end;

function NewInstructionsSelector: IhInstructionsSelector;
begin
  result := ThInstructionsSelector.Create;
end;

end.
